perm filename S1.F4[LX,LCS]1 blob
sn#164494 filedate 1975-06-13 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 7/74 ********** SCORE ********** LELAND SMITH, SEP.1969
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
C GENERATION PROGRAM.
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
C SCANW, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /INS/ INST(27),BG(60)
C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,TPALN(4),JED
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
1 ,P1(27),JFM(4),COPY(30),IFM(80)
1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
DIMENSION LIST(78),JNP(80)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
DATA KZY/27/,ISEMI/';'/,IQT/'"'/
1, JFM(3)/','/
C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
DATA IBLA/' '/,IXX/'X'/
1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
LPAR=0
IPRN=0
QX=0.
MOT=0
RETRO=-1.
INVRT=-1
ICON=-1
LCNT=1
PARENS=0
JZ=1
CALL RNDINT
C INIT RAND NUM GENERATOR.
CC PR=0
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
KB=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
C IQ IS FOR RESTART FLAG
IPT(K,1)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C SECONDS TO BE OMITTED, DUR AT CUTOFF.
JED=-1
2112 TYPE 8002
1112 ACCEPT 77732,JNP
JFM(4)='5F)'
JFM(1)=' (A'
C FOR FREE 'A' FORMAT
CALL FMT(JFM,JNP,MLX)
REREAD JFM,K,TF,AMPFAC,OP1,DURX
C JFM IS THE CURRENT FORMAT STATEMENT
IF(K.NE.'EDIT')GO TO 3112
JED=0
GO TO 2112
C 'E(DIT)' GOES TO EDIT MODE
3112 IF(TF.EQ.0)TF=1.
IF(AMPFAC.EQ.0)AMPFAC=1.
21122 IF(K.NE.'TYPE')GO TO 128
ITYP=0
DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
IFLNM='FOR21'
REWIND 21
GO TO 3127
8001 FORMAT(A5,5F)
77732 FORMAT(80A1)
300 FORMAT(I,3F)
128 IF(K.NE.'INFO')GO TO 3128
TYPE 8002
TYPE 1113
TYPE 118
TYPE 1114
TYPE 8002
GO TO 1112
118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
8002 FORMAT(' **** NEW VERSION ****',//' TYPE FILE NAME-- '$)
1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
3128 IF(K.NE.IBLA)IFLNM=K
CALL IFILE(1,IFLNM)
READ(1,300)LN,IXIN
C CHECK FOR LINE NUMBERS ONLY.
REWIND 1
CALL IFILE(1,IFLNM)
3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
5127 TYPE 118
IF(DURX.EQ.0)DURX=19999.
IXIN=1
INONLY=-1
ACCEPT 300,MX,X,Y,Z
IF(MX.NE.99)GO TO 6127
TYPE FINM
ACCEPT 8001,ISLAC
GO TO 5127
6127 IF(Z.NE.0)INONLY=Z
IF(X.NE.0)IXIN=X
C MX=3 GIVES DURS ONLY
C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
MZ=0
JOUT=5
C 5=OUTPUT TO TTY
SOS=-1.
IF(Y.NE.0)SOS=0
C IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
IF(MX.NE.22)GO TO 2107
JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
CC JOUT=22
CC REWIND 22
2107 IF(MX.LE.1)MX=MX-2
IF(MX.EQ.-2)GO TO 77
IF(MX.EQ.2)GO TO 77
IF(MX.NE.22)GO TO 177
77 MZ=-1
177 IF(MX.EQ.4)MZ=-4
CALL READIT
END